# Figure 4: Share of Selective Abstention by Ordered Net Benefit


# 1. Load Packages ----

library(tidyverse)
library(ggpubr)
library(xtable)
library(latex2exp)

# 2. Read in Data ----
# Survey Data
load(file = "df_voxit_individual_analysis.RData")

# Administrative Data
load(file = "df_voxit_props.RData")

# 3. Data Preparation ----
# 3.a Survey Data ----

# U 1st
U_1.1 <- mean(voxit_individual$eb_prop_1st[voxit_individual$prop_voxit==1], na.rm = T)
U_1.2 <- mean(voxit_individual$eb_prop_1st[voxit_individual$prop_voxit==2], na.rm = T)
U_1.3 <- mean(voxit_individual$eb_prop_1st[voxit_individual$prop_voxit==3], na.rm = T)
U_1.4 <- mean(voxit_individual$eb_prop_1st[voxit_individual$prop_voxit==4], na.rm = T)
U_1.5 <- mean(voxit_individual$eb_prop_1st[voxit_individual$prop_voxit==5], na.rm = T)
U_1.6 <- mean(voxit_individual$eb_prop_1st[voxit_individual$prop_voxit==6], na.rm = T)

# U 2nd
U_2.2 <- mean(voxit_individual$eb_prop_2nd[voxit_individual$prop_voxit==2], na.rm = T)
U_2.3 <- mean(voxit_individual$eb_prop_2nd[voxit_individual$prop_voxit==3], na.rm = T)
U_2.4 <- mean(voxit_individual$eb_prop_2nd[voxit_individual$prop_voxit==4], na.rm = T)
U_2.5 <- mean(voxit_individual$eb_prop_2nd[voxit_individual$prop_voxit==5], na.rm = T)
U_2.6 <- mean(voxit_individual$eb_prop_2nd[voxit_individual$prop_voxit==6], na.rm = T)

# U 3rd
U_3.3 <- mean(voxit_individual$eb_prop_3rd[voxit_individual$prop_voxit==3], na.rm = T)
U_3.4 <- mean(voxit_individual$eb_prop_3rd[voxit_individual$prop_voxit==4], na.rm = T)
U_3.5 <- mean(voxit_individual$eb_prop_3rd[voxit_individual$prop_voxit==5], na.rm = T)
U_3.6 <- mean(voxit_individual$eb_prop_3rd[voxit_individual$prop_voxit==6], na.rm = T)

# U 4th
U_4.4 <- mean(voxit_individual$eb_prop_4th[voxit_individual$prop_voxit==4], na.rm = T)
U_4.5 <- mean(voxit_individual$eb_prop_4th[voxit_individual$prop_voxit==5], na.rm = T)
U_4.6 <- mean(voxit_individual$eb_prop_4th[voxit_individual$prop_voxit==6], na.rm = T)

# U 5th
U_5.5 <- mean(voxit_individual$eb_prop_5th[voxit_individual$prop_voxit==5], na.rm = T)
U_5.6 <- mean(voxit_individual$eb_prop_5th[voxit_individual$prop_voxit==6], na.rm = T)

# U 6th
U_6.6 <- mean(voxit_individual$eb_prop_6th[voxit_individual$prop_voxit==6], na.rm = T)

# Observations
n1 <- length(voxit_individual$eb_prop_1st[voxit_individual$prop_voxit==1])
n2 <- length(voxit_individual$eb_prop_1st[voxit_individual$prop_voxit==2])
n3 <- length(voxit_individual$eb_prop_1st[voxit_individual$prop_voxit==3])
n4 <- length(voxit_individual$eb_prop_1st[voxit_individual$prop_voxit==4])
n5 <- length(voxit_individual$eb_prop_1st[voxit_individual$prop_voxit==5])
n6 <- length(voxit_individual$eb_prop_1st[voxit_individual$prop_voxit==6])

# Table
se.U_1 <- c(U_1.1, U_1.2, U_1.3, U_1.4, U_1.5, U_1.6, "U1")

se.U_2 <- c(NA, U_2.2, U_2.3, U_2.4, U_2.5, U_2.6, "U2")

se.U_3 <- c(NA, NA, U_3.3, U_3.4, U_3.5, U_3.6, "U3")

se.U_4 <- c(NA, NA, NA, U_4.4, U_4.5, U_4.6, "U4")

se.U_5 <- c(NA, NA, NA, NA, U_5.5, U_5.6, "U5")

se.U_6 <- c(NA, NA, NA, NA, NA, U_6.6, "U6")

obs <- c(n1, n2, n3, n4, n5, n6)

shares <- rbind(se.U_1, se.U_2, se.U_3, se.U_4, se.U_5, se.U_6)
xtable(shares, digits = 3)

# Prepare Heatmap Data
df_shares <- as.data.frame(shares)
names(df_shares) <- c("1", "2", "3", "4", "5", "6", "prop")
df_long_a <- df_shares %>%
  pivot_longer(data = .,
               cols = c("1", "2", "3", "4", "5", "6")) %>%
  mutate(value = as.numeric(value),
         prop = factor(prop, levels = c("U6", "U5", "U4", "U3", "U2", "U1"))) %>%
  mutate_if(is.numeric, round, digits = 2)

# 3.b Admin Data ----
# Compute Selective Abstention Rate per Proposition
# U 1st
U_1.1 <- mean(voxit_props$empty_ballot_mod[voxit_props$prop_order_nb==1 &
                                             voxit_props$prop_voxit==1], na.rm = T)
U_1.2 <- mean(voxit_props$empty_ballot_mod[voxit_props$prop_order_nb==1 &
                                             voxit_props$prop_voxit==2], na.rm = T)
U_1.3 <- mean(voxit_props$empty_ballot_mod[voxit_props$prop_order_nb==1 &
                                             voxit_props$prop_voxit==3], na.rm = T)
U_1.4 <- mean(voxit_props$empty_ballot_mod[voxit_props$prop_order_nb==1 &
                                             voxit_props$prop_voxit==4], na.rm = T)
U_1.5 <- mean(voxit_props$empty_ballot_mod[voxit_props$prop_order_nb==1 &
                                             voxit_props$prop_voxit==5], na.rm = T)
U_1.6 <- mean(voxit_props$empty_ballot_mod[voxit_props$prop_order_nb==1 &
                                             voxit_props$prop_voxit==6], na.rm = T)


# U 2nd
U_2.2 <- mean(voxit_props$empty_ballot_mod[voxit_props$prop_order_nb==2 &
                                             voxit_props$prop_voxit==2], na.rm = T)
U_2.3 <- mean(voxit_props$empty_ballot_mod[voxit_props$prop_order_nb==2 &
                                             voxit_props$prop_voxit==3], na.rm = T)
U_2.4 <- mean(voxit_props$empty_ballot_mod[voxit_props$prop_order_nb==2 &
                                             voxit_props$prop_voxit==4], na.rm = T)
U_2.5 <- mean(voxit_props$empty_ballot_mod[voxit_props$prop_order_nb==2 &
                                             voxit_props$prop_voxit==5], na.rm = T)
U_2.6 <- mean(voxit_props$empty_ballot_mod[voxit_props$prop_order_nb==2 &
                                             voxit_props$prop_voxit==6], na.rm = T)


# U 3rd
U_3.3 <- mean(voxit_props$empty_ballot_mod[voxit_props$prop_order_nb==3 &
                                             voxit_props$prop_voxit==3], na.rm = T)
U_3.4 <- mean(voxit_props$empty_ballot_mod[voxit_props$prop_order_nb==3 &
                                             voxit_props$prop_voxit==4], na.rm = T)
U_3.5 <- mean(voxit_props$empty_ballot_mod[voxit_props$prop_order_nb==3 &
                                             voxit_props$prop_voxit==5], na.rm = T)
U_3.6 <- mean(voxit_props$empty_ballot_mod[voxit_props$prop_order_nb==3 &
                                             voxit_props$prop_voxit==6], na.rm = T)


# U 4th
U_4.4 <- mean(voxit_props$empty_ballot_mod[voxit_props$prop_order_nb==4 &
                                             voxit_props$prop_voxit==4], na.rm = T)
U_4.5 <- mean(voxit_props$empty_ballot_mod[voxit_props$prop_order_nb==4 &
                                             voxit_props$prop_voxit==5], na.rm = T)
U_4.6 <- mean(voxit_props$empty_ballot_mod[voxit_props$prop_order_nb==4 &
                                             voxit_props$prop_voxit==6], na.rm = T)


# U 5th
U_5.5 <- mean(voxit_props$empty_ballot_mod[voxit_props$prop_order_nb==5 &
                                             voxit_props$prop_voxit==5], na.rm = T)
U_5.6 <- mean(voxit_props$empty_ballot_mod[voxit_props$prop_order_nb==5 &
                                             voxit_props$prop_voxit==6], na.rm = T)

# U 6th
U_6.6 <- mean(voxit_props$empty_ballot_mod[voxit_props$prop_order_nb==6 &
                                             voxit_props$prop_voxit==6], na.rm = T)

# Observations
n1 <- length(voxit_props$empty_ballot_mod[voxit_props$prop_order_nb==1 &
                                            voxit_props$prop_voxit==1])
n2 <- length(voxit_props$empty_ballot_mod[voxit_props$prop_order_nb==1 &
                                            voxit_props$prop_voxit==2])
n3 <- length(voxit_props$empty_ballot_mod[voxit_props$prop_order_nb==1 &
                                            voxit_props$prop_voxit==3])
n4 <- length(voxit_props$empty_ballot_mod[voxit_props$prop_order_nb==1 &
                                            voxit_props$prop_voxit==4])
n5 <- length(voxit_props$empty_ballot_mod[voxit_props$prop_order_nb==1 &
                                            voxit_props$prop_voxit==5])
n6 <- length(voxit_props$empty_ballot_mod[voxit_props$prop_order_nb==1 &
                                            voxit_props$prop_voxit==6])

# Table
se.U_1 <- c(U_1.1, U_1.2, U_1.3, U_1.4, U_1.5, U_1.6, "U1")

se.U_2 <- c(NA, U_2.2, U_2.3, U_2.4, U_2.5, U_2.6, "U2")

se.U_3 <- c(NA, NA, U_3.3, U_3.4, U_3.5, U_3.6, "U3")

se.U_4 <- c(NA, NA, NA, U_4.4, U_4.5, U_4.6, "U4")

se.U_5 <- c(NA, NA, NA, NA, U_5.5, U_5.6, "U5")

se.U_6 <- c(NA, NA, NA, NA, NA, U_6.6, "U6")

obs <- c(n1, n2, n3, n4, n5, n6)

shares <- rbind(se.U_1, se.U_2, se.U_3, se.U_4, se.U_5, se.U_6)
xtable(shares, digits = 3)

# Prepare Heatmap Data
df_shares <- as.data.frame(shares)
names(df_shares) <- c("1", "2", "3", "4", "5", "6", "prop")
df_long_b <- df_shares %>%
  pivot_longer(data = .,
               cols = c("1", "2", "3", "4", "5", "6")) %>%
  mutate(value = as.numeric(value),
         prop = factor(prop, levels = c("U6", "U5", "U4", "U3", "U2", "U1"))) %>%
  mutate_if(is.numeric, round, digits = 2)


# 4. Generate Graph ----
# Survey Data
a_plot <- ggplot(data = df_long_a) +
  geom_tile(mapping = aes(x = name, y = prop, fill = as.numeric(value))) +
  scale_fill_gradient2(name = "Selective abstention rate",
                       low = "grey", high = "saddlebrown", na.value = "white",
                       labels = c("2%", "4%", "6%"),
                       breaks = c(2, 4, 6)) +
  geom_text(mapping = aes(x = name, y = prop, label = as.numeric(value)),
            size = 3) +
  theme_bw(base_size = 8) +
  scale_y_discrete(name = "Ordered propositions \n (according to the net benefit)",
                   labels = unname(TeX(c('$U^{6th}$', '$U^{5th}$',
                                         '$U^{4th}$',  '$U^{3rd}$',
                                         '$U^{2nd}$', '$U^{1st}$')))) +
  scale_x_discrete(name = "Number of concurrent propositions") +
  ggtitle(label = "(A) Survey Data")

# Admin Data
b_plot <- ggplot(data = df_long_b) +
  geom_tile(mapping = aes(x = name, y = prop, fill = as.numeric(value))) +
  scale_fill_gradient2(name = "Selective abstention rate",
                       low = "grey", high = "saddlebrown", na.value = "white",
                       labels = c("2%", "4%", "6%"),
                       breaks = c(2, 4, 6)) +
  geom_text(mapping = aes(x = name, y = prop, label = as.numeric(value)),
            size = 3) +
  theme_bw(base_size = 8) +
  scale_y_discrete(name = "Ordered propositions \n (according to the net benefit)",
                   labels = unname(TeX(c('$U^{6th}$', '$U^{5th}$',
                                         '$U^{4th}$',  '$U^{3rd}$',
                                         '$U^{2nd}$', '$U^{1st}$')))) +
  scale_x_discrete(name = "Number of concurrent propositions") +
  ggtitle(label = "(B) Administrative Data")

# 5. Save Graph ----
# Plot
ggarrange(a_plot, b_plot, common.legend = T,
          legend = "bottom")
ggsave(filename = "Figure4.pdf", height = 3.08, width = 6.33)





